home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio 2000
/
Ham Radio 2000.iso
/
ham2000
/
misc
/
dspice0s
/
disto.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-21
|
70KB
|
1,876 lines
/* disto.f -- translated by f2c (version of 3 February 1990 3:36:42).
You must link the resulting object file with the libraries:
-lF77 -lI77 -lm -lc (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct {
integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens,
nsens, ifour, nfour, ifield, icode, idelim, icolum, insize,
junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr,
numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap,
iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3,
lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod,
nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf,
irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar,
lvntmp;
} tabinf_;
#define tabinf_1 tabinf_
struct {
doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas,
rstats[50];
integer iwidth, lwidth, nopage;
} miscel_;
#define miscel_1 miscel_
struct {
integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt,
nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
} cirdat_;
#define cirdat_1 cirdat_
struct {
doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu,
sfactr;
integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno,
itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
} status_;
#define status_1 status_
struct {
doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin,
reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
pivrel;
} knstnt_;
#define knstnt_1 knstnt_
struct {
integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod,
lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
} flags_;
#define flags_1 flags_
struct {
doublereal fstart, fstop, fincr, skw2, refprl, spw2;
integer jacflg, idfreq, inoise, nosprt, nosout, nosin, idist, idprt;
} ac_;
#define ac_1 ac_
struct {
doublereal value[200000];
} blank_;
#define blank_1 blank_
/* Table of constant values */
static integer c__0 = 0;
static integer c__1 = 1;
/*< subroutine disto(loco) >*/
/* Subroutine */ int disto_(loco)
integer *loco;
{
/* Initialized data */
static struct {
char e_1[32];
doublereal e_2;
} equiv_142 = { {'d', 'i', 's', 't', 'o', 'r', 't', 'i', 'o', 'n', ' '
, 'a', 'n', 'a', 'l', 'y', 's', 'i', 's', ' ', ' ', ' ', ' ',
' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
#define distit ((doublereal *)&equiv_142)
/* Format strings */
static char fmt_111[] = "(///5x,\0022nd harmonic distortion\002,30x,\002\
freq1 = \002,1pd9.2,\002 hz\002//5x,\002distortion frequency \002,d9.2,\
\002 hz\002,16x,\002mag \002,d9.3,3x,\002phs \002,0pf7.2)";
static char fmt_121[] = "(\0021\002,4x,\0023rd harmonic distortion\002,3\
0x,\002freq1 = \002,1pd9.2,\002 hz\002//5x,\002distortion frequency \002,d\
9.2,\002 hz\002,16x,\002mag \002,d9.3,3x,\002phs \002,0pf7.2)";
static char fmt_151[] = "(\0021\002,4x,\0022nd order intermodulation dif\
ference component\002,7x,\002freq1 = \002,1pd9.2,\002 hz\002,15x,\002freq2 \
= \002,d9.2,\002 hz\002//5x,\002distortion frequency \002,d9.2,\002 hz\
\002,16x,\002mag \002,d9.3,3x,\002phs \002,0pf7.2,9x,\002mag \002,1pd9.3,3x\
,\002phs \002,0pf7.2)";
static char fmt_161[] = "(\0021\002,4x,\0022nd order intermodulation sum\
component\002,14x,\002freq1 = \002,1pd9.2,\002 hz\002,15x,\002freq2 = \002\
,d9.2,\002 hz\002//5x,\002distortion frequency \002,d9.2,\002 hz\002,16x\
,\002mag \002,d9.3,3x,\002phs \002,0pf7.2,9x,\002mag \002,1pd9.3,3x,\002phs\
\002,0pf7.2)";
static char fmt_171[] = "(\0021\002,4x,\0023rd order intermodulation dif\
ference component\002,7x,\002freq1 = \002,1pd9.2,\002 hz\002,15x,\002freq2 \
= \002,d9.2,\002 hz\002//5x,\002distortion frequency \002,d9.2,\002 hz\
\002,16x,\002mag \002,d9.3,3x,\002phs \002,0pf7.2,9x,\002mag \002,1pd9.3,3x\
,\002phs \002,0pf7.2)";
static char fmt_211[] = "(\0020warning: underflow \002,i4,\002 time(s) \
in distortion analysis at freq = \002,1pd9.3,\002 hz\002)";
static char fmt_301[] = "(////1x,\002bjt distortion components\002//1x\
,\002name\002,11x,\002gm\002,8x,\002gpi\002,7x,\002go\002,8x,\002gmu\002,6x\
,\002gmo2\002,7x,\002cb\002,8x,\002cbr\002,7x,\002cje\002,7x,\002cjc\002,6x\
,\002total\002)";
static char fmt_311[] = "(////1x,\002bjt distortion components\002//1x\
,\002name\002,11x,\002gm\002,8x,\002gpi\002,7x,\002go\002,8x,\002gmu\002,6x\
,\002gmo2\002,7x,\002cb\002,8x,\002cbr\002,7x,\002cje\002,7x,\002cjc\002,6x\
,\002gm203\002,5x,\002gmo23\002,5x,\002total\002)";
static char fmt_446[] = "(\0020\002,a8,\002mag\002,1p12d10.3)";
static char fmt_447[] = "(9x,\002phs\002,12(1x,f7.2,2x))";
static char fmt_501[] = "(////1x,\002diode distortion components\002//1x\
,\002name\002,11x,\002geq\002,7x,\002cb\002,8x,\002cj\002,7x,\002total\002)";
static char fmt_781[] = "(///5x,\002hd2 magnitude \002,1pd10.3,5x\
,\002phase \002,0pf7.2,5x,\002= \002,f7.2,\002 db\002)";
static char fmt_791[] = "(///5x,\002hd3 magnitude \002,1pd10.3,5x\
,\002phase \002,0pf7.2,5x,\002= \002,f7.2,\002 db\002)";
static char fmt_841[] = "(///5x,\002im2d magnitude \002,1pd10.3,5x\
,\002phase \002,0pf7.2,5x,\002= \002,f7.2,\002 db\002)";
static char fmt_851[] = "(///5x,\002im2s magnitude \002,1pd10.3,5x\
,\002phase \002,0pf7.2,5x,\002= \002,f7.2,\002 db\002)";
static char fmt_861[] = "(///5x,\002im3 magnitude \002,1pd10.3,5x\
,\002phase \002,0pf7.2,5x,\002= \002,f7.2,\002 db\002)";
static char fmt_866[] = "(////5x,\002approximate cross modulation compon\
ents\002)";
static char fmt_871[] = "(/5x,\002cma magnitude \002,1pd10.3,24x\
,\002= \002,0pf7.2,\002 db\002)";
static char fmt_881[] = "(/5x,\002cmp magnitude \002,1pd10.3,24x\
,\002= \002,0pf7.2,\002 db\002)";
/* System generated locals */
integer i_1, i_2;
doublereal d_1, d_2, d_3;
complex q_1, q_2, q_3, q_4, q_5, q_6, q_7, q_8, q_9, q_10;
doublecomplex z_1, z_2, z_3, z_4, z_5, z_6, z_7, z_8;
static complex equiv_1[12];
/* Builtin functions */
double sqrt();
integer s_wsfe(), do_fio(), e_wsfe();
void r_cnjg();
double r_imag(), d_lg10(), cos(), sin();
/* Local variables */
static complex bcw12, bew12, cew12;
static integer locd;
static doublereal omag;
static integer idnn;
static doublereal gmo23;
#define cvdo (equiv_1)
static integer idnp, locv, loct;
static doublereal gm2o3, xmag;
static integer kntr;
static doublereal xphs;
static integer locm;
static complex dscb1;
static doublereal o2mag;
static integer node1, node2, node3;
static doublereal o3mag;
static complex dsgm2, dsgo2;
static doublereal freq1, freq2, o2log, o3log;
static integer icvw1, icvw2;
static doublereal o2phs, o3phs;
extern /* Subroutine */ int zero8_();
static integer j;
static complex cvabc, cvabe, cvace, dgm2o3, dgmo23;
static doublereal rload, freqd;
extern /* Subroutine */ int acsol_();
static integer icv2w1, icvw12;
static doublereal o12mag, o12phs;
static complex dscje1, dscjc1, dscdb1, dscdj1, dscb1r, cvout;
static integer iprnt;
extern /* Subroutine */ int title_();
static complex difvi1, difvi2, difvi3;
extern /* Subroutine */ int copy16_();
static complex difvn1, difvn2, difvn3, dsgpi2, dsgmo2;
static doublereal ow2mag, o12log, o21mag, o21phs;
static complex dsgmu2;
static doublereal o21log;
static complex disto1, disto2, disto3;
static integer iflag;
static doublereal ow2phs;
extern /* Subroutine */ int acload_(), acdcmp_();
static integer icvadj;
extern /* Subroutine */ int acasol_();
static doublereal cmalog;
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)
static complex bcw, bew, cew, cvdist;
extern /* Subroutine */ int magphs_();
static doublereal ophase;
static integer kdisto;
static doublereal arg;
#define vdo ((real *)equiv_1)
static integer ititle, loc;
static doublereal go2, gm2, cb1, go3, gm3, cb2, cma, cdb1, cdb2, cmp,
cmplog, cjc1, cjc2, cje1, cje2, cdj1, cdj2, cb1r, cb2r;
static complex bc2w, bcw2, be2w, ce2w, bew2, cew2, dsg2;
static doublereal gmo2, gpi2, gpi3, geq2, gmu2, gmu3, geq3;
/* Fortran I/O blocks */
static cilist io__26 = { 0, 0, 0, fmt_111, 0 };
static cilist io__27 = { 0, 0, 0, fmt_121, 0 };
static cilist io__28 = { 0, 0, 0, fmt_151, 0 };
static cilist io__31 = { 0, 0, 0, fmt_161, 0 };
static cilist io__32 = { 0, 0, 0, fmt_171, 0 };
static cilist io__33 = { 0, 0, 0, fmt_211, 0 };
static cilist io__96 = { 0, 0, 0, fmt_301, 0 };
static cilist io__97 = { 0, 0, 0, fmt_446, 0 };
static cilist io__98 = { 0, 0, 0, fmt_447, 0 };
static cilist io__101 = { 0, 0, 0, fmt_311, 0 };
static cilist io__102 = { 0, 0, 0, fmt_446, 0 };
static cilist io__103 = { 0, 0, 0, fmt_447, 0 };
static cilist io__114 = { 0, 0, 0, fmt_501, 0 };
static cilist io__115 = { 0, 0, 0, fmt_446, 0 };
static cilist io__116 = { 0, 0, 0, fmt_447, 0 };
static cilist io__120 = { 0, 0, 0, fmt_781, 0 };
static cilist io__124 = { 0, 0, 0, fmt_791, 0 };
static cilist io__128 = { 0, 0, 0, fmt_841, 0 };
static cilist io__129 = { 0, 0, 0, fmt_851, 0 };
static cilist io__133 = { 0, 0, 0, fmt_861, 0 };
static cilist io__138 = { 0, 0, 0, fmt_866, 0 };
static cilist io__139 = { 0, 0, 0, fmt_871, 0 };
static cilist io__140 = { 0, 0, 0, fmt_881, 0 };
/*< implicit double precision (a-h,o-z) >*/
/* this routine performs the small-signal distortion analysis. */
/* spice version 2g.6 sccsid=tabinf 3/15/83 */
/*< common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
/*< 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
/*< 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
/*< 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
/*< 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
/*< 5 imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
/*< 6 loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
/*< 7 irowno,jcolno,nttbr,nttar,lvntmp >*/
/* spice version 2g.6 sccsid=miscel 3/15/83 */
/*< common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
/*< 1 defas,rstats(50),iwidth,lwidth,nopage >*/
/* spice version 2g.6 sccsid=cirdat 3/15/83 */
/*< common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
/*< 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
/* spice version 2g.6 sccsid=status 3/15/83 */
/*< common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
/*< 1 xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
/*< 2 iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
/* spice version 2g.6 sccsid=knstnt 3/15/83 */
/*< common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
/*< 1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
/*< 2 pivtol,pivrel >*/
/* spice version 2g.6 sccsid=flags 3/15/83 */
/*< common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
/*< 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
/* spice version 2g.6 sccsid=ac 3/15/83 */
/*< common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq, >*/
/*< 1 inoise,nosprt,nosout,nosin,idist,idprt >*/
/* spice version 2g.6 sccsid=blank 3/15/83 */
/*< common /blank/ value(200000) >*/
/*< integer nodplc(64) >*/
/*< complex cvalue(32) >*/
/*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
/*< complex difvn1,difvn2,difvn3,difvi1,difvi2,difvi3,dsgo2,dsgm2, >*/
/*< 1 dsgmu2,dsgpi2,dscb1,dscb1r,dscje1,dscjc1,disto1,disto2,disto3, >*/
/*< 2 dsgmo2,dgm2o3,dgmo23,bew,cew,bcw,be2w,ce2w,bc2w,bew2,cew2, >*/
/*< 3 bcw2,bew12,cew12,bcw12,dscdb1,dscdj1,dsg2,cvabe,cvabc,cvace, >*/
/*< 4 cvout,cvdist >*/
/*< dimension distit(4) >*/
/*< dimension vdo(2,12) >*/
/*< complex cvdo(12) >*/
/*< real vdo >*/
/*< equivalence (cvdo(1),vdo(1,1)) >*/
/*< data distit / 8hdistorti, 8hon analy, 8hsis , 8h / >*/
/*< icvw1=ld1 >*/
icvw1 = tabinf_1.ld1;
/*< icv2w1=icvw1+nstop >*/
icv2w1 = icvw1 + cirdat_1.nstop;
/*< icvw2=icv2w1+nstop >*/
icvw2 = icv2w1 + cirdat_1.nstop;
/*< icvw12=icvw2+nstop >*/
icvw12 = icvw2 + cirdat_1.nstop;
/*< icvadj=icvw12+nstop >*/
icvadj = icvw12 + cirdat_1.nstop;
/*< iprnt=0 >*/
iprnt = 0;
/*< if (icalc.ge.2) go to 10 >*/
if (status_1.icalc >= 2) {
goto L10;
}
/*< idnp=nodplc(idist+2) >*/
idnp = nodplc[ac_1.idist + 1];
/*< idnn=nodplc(idist+3) >*/
idnn = nodplc[ac_1.idist + 2];
/*< locv=nodplc(idist+1) >*/
locv = nodplc[ac_1.idist];
/*< rload=1.0d0/value(locv+1) >*/
rload = 1. / blank_1.value[locv];
/*< kntr=1 >*/
kntr = 1;
/*< 10 if (idprt.eq.0) go to 30 >*/
L10:
if (ac_1.idprt == 0) {
goto L30;
}
/*< if (kntr.gt.icalc) go to 30 >*/
if (kntr > status_1.icalc) {
goto L30;
}
/*< iprnt=1 >*/
iprnt = 1;
/*< kntr=kntr+idprt >*/
kntr += ac_1.idprt;
/*< call title(0,lwidth,1,distit) >*/
title_(&c__0, &miscel_1.lwidth, &c__1, distit);
/*< 30 freq1=dble(real(cvalue(loco+1))) >*/
L30:
i_1 = *loco;
freq1 = (doublereal) cvalue[i_1].r;
/*< freq2=skw2*freq1 >*/
freq2 = ac_1.skw2 * freq1;
/*< call copy16(cvalue(lcvn+1),cvalue(icvw1+1),nstop) >*/
copy16_(&cvalue[tabinf_1.lcvn], &cvalue[icvw1], &cirdat_1.nstop);
/*< cvout=cvalue(icvw1+idnp)-cvalue(icvw1+idnn) >*/
i_1 = icvw1 + idnp - 1;
i_2 = icvw1 + idnn - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[i_2]
.i;
cvout.r = q_1.r, cvout.i = q_1.i;
/*< call magphs(cvout,omag,ophase) >*/
magphs_(&cvout, &omag, &ophase);
/* begin the distortion analysis */
/*< do 1000 kdisto=1,7 >*/
for (kdisto = 1; kdisto <= 7; ++kdisto) {
/*< cvdist=cmplx(0.0e0,0.0e0) >*/
cvdist.r = (float)0., cvdist.i = (float)0.;
/*< go to (1000,110,120,130,140,160,170),kdisto >*/
switch (kdisto) {
case 1: goto L1000;
case 2: goto L110;
case 3: goto L120;
case 4: goto L130;
case 5: goto L140;
case 6: goto L160;
case 7: goto L170;
}
/*< 110 freqd=2.0d0*freq1 >*/
L110:
freqd = freq1 * 2.;
/*< arg=dsqrt(2.0d0*rload*refprl)/(omag*omag) >*/
arg = sqrt(rload * 2. * ac_1.refprl) / (omag * omag);
/*< if (iprnt.eq.0) go to 200 >*/
if (iprnt == 0) {
goto L200;
}
/*< write (iofile,111) freq1,freqd,omag,ophase >*/
io__26.ciunit = status_1.iofile;
s_wsfe(&io__26);
do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&omag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ophase, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 111 format (///5x,'2nd harmonic distortion',30x,'freq1 = ',1pd9.2, >*/
/*< 1 ' hz'//5x,'distortion frequency ',d9.2,' hz',16x, >*/
/*< 2 'mag ',d9.3,3x,'phs ',0pf7.2) >*/
/*< go to 200 >*/
goto L200;
/*< 120 freqd=3.0d0*freq1 >*/
L120:
freqd = freq1 * 3.;
/*< arg=2.0d0*rload*refprl/(omag*omag*omag) >*/
arg = rload * 2. * ac_1.refprl / (omag * omag * omag);
/*< if (iprnt.eq.0) go to 200 >*/
if (iprnt == 0) {
goto L200;
}
/*< write (iofile,121) freq1,freqd,omag,ophase >*/
io__27.ciunit = status_1.iofile;
s_wsfe(&io__27);
do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&omag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ophase, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 121 format (1h1,4x,'3rd harmonic distortion',30x,'freq1 = ',1pd9.2, >*/
/*< 1 ' hz'//5x,'distortion frequency ',d9.2,' hz',16x, >*/
/*< 2 'mag ',d9.3,3x,'phs ',0pf7.2) >*/
/*< go to 200 >*/
goto L200;
/*< 130 freqd=freq2 >*/
L130:
freqd = freq2;
/*< go to 200 >*/
goto L200;
/*< 140 freqd=freq1-freq2 >*/
L140:
freqd = freq1 - freq2;
/*< arg=dsqrt(2.0d0*rload*refprl)*spw2/(omag*omag) >*/
arg = sqrt(rload * 2. * ac_1.refprl) * ac_1.spw2 / (omag * omag);
/*< if (iprnt.eq.0) go to 200 >*/
if (iprnt == 0) {
goto L200;
}
/*< write (iofile,151) freq1,freq2,freqd,omag,ophase,ow2mag,ow2phs >*/
io__28.ciunit = status_1.iofile;
s_wsfe(&io__28);
do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&freq2, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&omag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ophase, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ow2mag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ow2phs, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 151 format (1h1,4x,'2nd order intermodulation difference component', >*/
/*< 1 7x,'freq1 = ',1pd9.2,' hz',15x,'freq2 = ',d9.2,' hz'// >*/
/*< 2 5x,'distortion frequency ',d9.2,' hz',16x,'mag ', >*/
/*< 3 d9.3,3x,'phs ',0pf7.2,9x,'mag ',1pd9.3,3x,'phs ',0pf7.2) >*/
/*< go to 200 >*/
goto L200;
/*< 160 freqd=freq1+freq2 >*/
L160:
freqd = freq1 + freq2;
/*< arg=dsqrt(2.0d0*rload*refprl)*spw2/(omag*omag) >*/
arg = sqrt(rload * 2. * ac_1.refprl) * ac_1.spw2 / (omag * omag);
/*< if (iprnt.eq.0) go to 200 >*/
if (iprnt == 0) {
goto L200;
}
/*< write (iofile,161) freq1,freq2,freqd,omag,ophase,ow2mag,ow2phs >*/
io__31.ciunit = status_1.iofile;
s_wsfe(&io__31);
do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&freq2, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&omag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ophase, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ow2mag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ow2phs, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 161 format (1h1,4x,'2nd order intermodulation sum component', >*/
/*< 1 14x,'freq1 = ',1pd9.2,' hz',15x,'freq2 = ',d9.2,' hz'// >*/
/*< 2 5x,'distortion frequency ',d9.2,' hz',16x,'mag ', >*/
/*< 3 d9.3,3x,'phs ',0pf7.2,9x,'mag ',1pd9.3,3x,'phs ',0pf7.2) >*/
/*< go to 200 >*/
goto L200;
/*< 170 freqd=2.0d0*freq1-freq2 >*/
L170:
freqd = freq1 * 2. - freq2;
/*< arg=2.0d0*rload*refprl*spw2/(omag*omag*omag) >*/
arg = rload * 2. * ac_1.refprl * ac_1.spw2 / (omag * omag * omag);
/*< if (iprnt.eq.0) go to 200 >*/
if (iprnt == 0) {
goto L200;
}
/*< write (iofile,171) freq1,freq2,freqd,omag,ophase,ow2mag,ow2phs >*/
io__32.ciunit = status_1.iofile;
s_wsfe(&io__32);
do_fio(&c__1, (char *)&freq1, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&freq2, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&omag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ophase, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ow2mag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&ow2phs, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 171 format (1h1,4x,'3rd order intermodulation difference component', >*/
/*< 1 7x,'freq1 = ',1pd9.2,' hz',15x,'freq2 = ',d9.2,' hz'// >*/
/*< 2 5x,'distortion frequency ',d9.2,' hz',16x,'mag ', >*/
/*< 3 d9.3,3x,'phs ',0pf7.2,9x,'mag ',1pd9.3,3x,'phs ',0pf7.2) >*/
/* load and decompose y matrix */
/*< 200 omega=twopi*freqd >*/
L200:
status_1.omega = knstnt_1.twopi * freqd;
/*< igoof=0 >*/
flags_1.igoof = 0;
/*< call acload >*/
acload_();
/*< call acdcmp >*/
acdcmp_();
/*< if (igoof.eq.0) go to 220 >*/
if (flags_1.igoof == 0) {
goto L220;
}
/*< write (iofile,211) igoof,freqd >*/
io__33.ciunit = status_1.iofile;
s_wsfe(&io__33);
do_fio(&c__1, (char *)&flags_1.igoof, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&freqd, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 211 format('0warning: underflow ',i4,' time(s) in distortion analysis >*/
/*< 1 at freq = ',1pd9.3,' hz') >*/
/*< igoof=0 >*/
flags_1.igoof = 0;
/*< 220 if (kdisto.eq.4) go to 710 >*/
L220:
if (kdisto == 4) {
goto L710;
}
/* obtain adjoint solution */
/*< call zero8(value(lvn+1),nstop) >*/
zero8_(&blank_1.value[tabinf_1.lvn], &cirdat_1.nstop);
/*< call zero8(value(imvn+1),nstop) >*/
zero8_(&blank_1.value[tabinf_1.imvn], &cirdat_1.nstop);
/*< value(lvn+idnp)=-1.0d0 >*/
blank_1.value[tabinf_1.lvn + idnp - 1] = -1.;
/*< value(lvn+idnn)=+1.0d0 >*/
blank_1.value[tabinf_1.lvn + idnn - 1] = 1.;
/*< call acasol >*/
acasol_();
/*< call copy16(cvalue(lcvn+1),cvalue(icvadj+1),nstop) >*/
copy16_(&cvalue[tabinf_1.lcvn], &cvalue[icvadj], &cirdat_1.nstop);
/*< call zero8(value(lvn+1),nstop) >*/
zero8_(&blank_1.value[tabinf_1.lvn], &cirdat_1.nstop);
/*< call zero8(value(imvn+1),nstop) >*/
zero8_(&blank_1.value[tabinf_1.imvn], &cirdat_1.nstop);
/* bjts */
/*< if (jelcnt(12).eq.0) go to 500 >*/
if (cirdat_1.jelcnt[11] == 0) {
goto L500;
}
/*< ititle=0 >*/
ititle = 0;
/*< 301 format (////1x,'bjt distortion components'//1x,'name',11x,'gm', >*/
/*< 1 8x,'gpi',7x,'go',8x,'gmu',6x,'gmo2',7x,'cb',8x,'cbr',7x,'cje', >*/
/*< 2 7x,'cjc',6x,'total') >*/
/* L301: */
/*< 311 format (////1x,'bjt distortion components'//1x,'name',11x,'gm', >*/
/*< 1 8x,'gpi',7x,'go',8x,'gmu',6x,'gmo2',7x,'cb',8x,'cbr',7x,'cje', >*/
/*< 2 7x,'cjc',6x,'gm203',5x,'gmo23',5x,'total') >*/
/* L311: */
/*< 320 loc=locate(12) >*/
/* L320: */
loc = cirdat_1.locate[11];
/*< 330 if ((loc.eq.0).or.(nodplc(loc+36).ne.0)) go to 500 >*/
L330:
if (loc == 0 || nodplc[loc + 35] != 0) {
goto L500;
}
/*< locv=nodplc(loc+1) >*/
locv = nodplc[loc];
/*< loct=lx0+nodplc(loc+22) >*/
loct = tabinf_1.lx0 + nodplc[loc + 21];
/*< locd=ld0+nodplc(loc+23) >*/
locd = tabinf_1.ld0 + nodplc[loc + 22];
/*< node1=nodplc(loc+5) >*/
node1 = nodplc[loc + 4];
/*< node2=nodplc(loc+6) >*/
node2 = nodplc[loc + 5];
/*< node3=nodplc(loc+7) >*/
node3 = nodplc[loc + 6];
/*< cje1=value(locd) >*/
cje1 = blank_1.value[locd - 1];
/*< cje2=value(locd+1) >*/
cje2 = blank_1.value[locd];
/*< cjc1=value(locd+2) >*/
cjc1 = blank_1.value[locd + 1];
/*< cjc2=value(locd+3) >*/
cjc2 = blank_1.value[locd + 2];
/*< go2=value(locd+4) >*/
go2 = blank_1.value[locd + 3];
/*< gmo2=value(locd+5) >*/
gmo2 = blank_1.value[locd + 4];
/*< gm2=value(locd+6) >*/
gm2 = blank_1.value[locd + 5];
/*< gmu2=value(locd+7) >*/
gmu2 = blank_1.value[locd + 6];
/*< gpi2=value(locd+8) >*/
gpi2 = blank_1.value[locd + 7];
/*< cb1=value(locd+11) >*/
cb1 = blank_1.value[locd + 10];
/*< cb1r=value(locd+12) >*/
cb1r = blank_1.value[locd + 11];
/*< go3=value(locd+13) >*/
go3 = blank_1.value[locd + 12];
/*< gmo23=value(locd+14) >*/
gmo23 = blank_1.value[locd + 13];
/*< gm2o3=value(locd+15) >*/
gm2o3 = blank_1.value[locd + 14];
/*< gm3=value(locd+16) >*/
gm3 = blank_1.value[locd + 15];
/*< gmu3=value(locd+17) >*/
gmu3 = blank_1.value[locd + 16];
/*< gpi3=value(locd+18) >*/
gpi3 = blank_1.value[locd + 17];
/*< cb2=value(locd+19) >*/
cb2 = blank_1.value[locd + 18];
/*< cb2r=value(locd+20) >*/
cb2r = blank_1.value[locd + 19];
/*< bew=cvalue(icvw1+node2)-cvalue(icvw1+node3) >*/
i_1 = icvw1 + node2 - 1;
i_2 = icvw1 + node3 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
bew.r = q_1.r, bew.i = q_1.i;
/*< cew=cvalue(icvw1+node1)-cvalue(icvw1+node3) >*/
i_1 = icvw1 + node1 - 1;
i_2 = icvw1 + node3 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
cew.r = q_1.r, cew.i = q_1.i;
/*< bcw=cvalue(icvw1+node2)-cvalue(icvw1+node1) >*/
i_1 = icvw1 + node2 - 1;
i_2 = icvw1 + node1 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
bcw.r = q_1.r, bcw.i = q_1.i;
/*< if (kdisto.eq.2) go to 370 >*/
if (kdisto == 2) {
goto L370;
}
/*< be2w=cvalue(icv2w1+node2)-cvalue(icv2w1+node3) >*/
i_1 = icv2w1 + node2 - 1;
i_2 = icv2w1 + node3 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
be2w.r = q_1.r, be2w.i = q_1.i;
/*< ce2w=cvalue(icv2w1+node1)-cvalue(icv2w1+node3) >*/
i_1 = icv2w1 + node1 - 1;
i_2 = icv2w1 + node3 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
ce2w.r = q_1.r, ce2w.i = q_1.i;
/*< bc2w=cvalue(icv2w1+node2)-cvalue(icv2w1+node1) >*/
i_1 = icv2w1 + node2 - 1;
i_2 = icv2w1 + node1 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
bc2w.r = q_1.r, bc2w.i = q_1.i;
/*< if (kdisto.eq.3) go to 380 >*/
if (kdisto == 3) {
goto L380;
}
/*< bew2=cvalue(icvw2+node2)-cvalue(icvw2+node3) >*/
i_1 = icvw2 + node2 - 1;
i_2 = icvw2 + node3 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
bew2.r = q_1.r, bew2.i = q_1.i;
/*< cew2=cvalue(icvw2+node1)-cvalue(icvw2+node3) >*/
i_1 = icvw2 + node1 - 1;
i_2 = icvw2 + node3 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
cew2.r = q_1.r, cew2.i = q_1.i;
/*< bcw2=cvalue(icvw2+node2)-cvalue(icvw2+node1) >*/
i_1 = icvw2 + node2 - 1;
i_2 = icvw2 + node1 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
bcw2.r = q_1.r, bcw2.i = q_1.i;
/*< if (kdisto.eq.5) go to 390 >*/
if (kdisto == 5) {
goto L390;
}
/*< if (kdisto.eq.6) go to 400 >*/
if (kdisto == 6) {
goto L400;
}
/*< bew12=cvalue(icvw12+node2)-cvalue(icvw12+node3) >*/
i_1 = icvw12 + node2 - 1;
i_2 = icvw12 + node3 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
bew12.r = q_1.r, bew12.i = q_1.i;
/*< cew12=cvalue(icvw12+node1)-cvalue(icvw12+node3) >*/
i_1 = icvw12 + node1 - 1;
i_2 = icvw12 + node3 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
cew12.r = q_1.r, cew12.i = q_1.i;
/*< bcw12=cvalue(icvw12+node2)-cvalue(icvw12+node1) >*/
i_1 = icvw12 + node2 - 1;
i_2 = icvw12 + node1 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
bcw12.r = q_1.r, bcw12.i = q_1.i;
/*< go to 410 >*/
goto L410;
/* calculate hd2 current generators */
/*< 370 difvn1=0.5d0*cew*cew >*/
L370:
z_2.r = cew.r * .5, z_2.i = cew.i * .5;
z_1.r = z_2.r * cew.r - z_2.i * cew.i, z_1.i = z_2.r * cew.i + z_2.i *
cew.r;
difvn1.r = z_1.r, difvn1.i = z_1.i;
/*< difvn2=0.5d0*bew*bew >*/
z_2.r = bew.r * .5, z_2.i = bew.i * .5;
z_1.r = z_2.r * bew.r - z_2.i * bew.i, z_1.i = z_2.r * bew.i + z_2.i *
bew.r;
difvn2.r = z_1.r, difvn2.i = z_1.i;
/*< difvn3=0.5d0*bcw*bcw >*/
z_2.r = bcw.r * .5, z_2.i = bcw.i * .5;
z_1.r = z_2.r * bcw.r - z_2.i * bcw.i, z_1.i = z_2.r * bcw.i + z_2.i *
bcw.r;
difvn3.r = z_1.r, difvn3.i = z_1.i;
/*< dsgmo2=gmo2*0.5d0*bew*cew >*/
d_1 = gmo2 * .5;
z_2.r = d_1 * bew.r, z_2.i = d_1 * bew.i;
z_1.r = z_2.r * cew.r - z_2.i * cew.i, z_1.i = z_2.r * cew.i + z_2.i *
cew.r;
dsgmo2.r = z_1.r, dsgmo2.i = z_1.i;
/*< go to 420 >*/
goto L420;
/* calculate hd3 current generators */
/*< 380 difvi1=0.50d0*cew*ce2w >*/
L380:
z_2.r = cew.r * .5, z_2.i = cew.i * .5;
z_1.r = z_2.r * ce2w.r - z_2.i * ce2w.i, z_1.i = z_2.r * ce2w.i +
z_2.i * ce2w.r;
difvi1.r = z_1.r, difvi1.i = z_1.i;
/*< difvn1=0.25d0*cew*cew*cew >*/
z_3.r = cew.r * .25, z_3.i = cew.i * .25;
z_2.r = z_3.r * cew.r - z_3.i * cew.i, z_2.i = z_3.r * cew.i + z_3.i *
cew.r;
z_1.r = z_2.r * cew.r - z_2.i * cew.i, z_1.i = z_2.r * cew.i + z_2.i *
cew.r;
difvn1.r = z_1.r, difvn1.i = z_1.i;
/*< difvi2=0.50d0*bew*be2w >*/
z_2.r = bew.r * .5, z_2.i = bew.i * .5;
z_1.r = z_2.r * be2w.r - z_2.i * be2w.i, z_1.i = z_2.r * be2w.i +
z_2.i * be2w.r;
difvi2.r = z_1.r, difvi2.i = z_1.i;
/*< difvn2=0.25d0*bew*bew*bew >*/
z_3.r = bew.r * .25, z_3.i = bew.i * .25;
z_2.r = z_3.r * bew.r - z_3.i * bew.i, z_2.i = z_3.r * bew.i + z_3.i *
bew.r;
z_1.r = z_2.r * bew.r - z_2.i * bew.i, z_1.i = z_2.r * bew.i + z_2.i *
bew.r;
difvn2.r = z_1.r, difvn2.i = z_1.i;
/*< difvi3=0.50d0*bcw*bc2w >*/
z_2.r = bcw.r * .5, z_2.i = bcw.i * .5;
z_1.r = z_2.r * bc2w.r - z_2.i * bc2w.i, z_1.i = z_2.r * bc2w.i +
z_2.i * bc2w.r;
difvi3.r = z_1.r, difvi3.i = z_1.i;
/*< difvn3=0.25d0*bcw*bcw*bcw >*/
z_3.r = bcw.r * .25, z_3.i = bcw.i * .25;
z_2.r = z_3.r * bcw.r - z_3.i * bcw.i, z_2.i = z_3.r * bcw.i + z_3.i *
bcw.r;
z_1.r = z_2.r * bcw.r - z_2.i * bcw.i, z_1.i = z_2.r * bcw.i + z_2.i *
bcw.r;
difvn3.r = z_1.r, difvn3.i = z_1.i;
/*< dsgmo2=gmo2*(bew*ce2w+be2w*cew)*0.5d0 >*/
q_2.r = bew.r * ce2w.r - bew.i * ce2w.i, q_2.i = bew.r * ce2w.i +
bew.i * ce2w.r;
q_3.r = be2w.r * cew.r - be2w.i * cew.i, q_3.i = be2w.r * cew.i +
be2w.i * cew.r;
q_1.r = q_2.r + q_3.r, q_1.i = q_2.i + q_3.i;
z_2.r = gmo2 * q_1.r, z_2.i = gmo2 * q_1.i;
z_1.r = z_2.r * .5, z_1.i = z_2.i * .5;
dsgmo2.r = z_1.r, dsgmo2.i = z_1.i;
/*< go to 430 >*/
goto L430;
/* calculate im2d current generators */
/*< 390 difvn1=cew*conjg(cew2) >*/
L390:
r_cnjg(&q_2, &cew2);
q_1.r = cew.r * q_2.r - cew.i * q_2.i, q_1.i = cew.r * q_2.i + cew.i *
q_2.r;
difvn1.r = q_1.r, difvn1.i = q_1.i;
/*< difvn2=bew*conjg(bew2) >*/
r_cnjg(&q_2, &bew2);
q_1.r = bew.r * q_2.r - bew.i * q_2.i, q_1.i = bew.r * q_2.i + bew.i *
q_2.r;
difvn2.r = q_1.r, difvn2.i = q_1.i;
/*< difvn3=bcw*conjg(bcw2) >*/
r_cnjg(&q_2, &bcw2);
q_1.r = bcw.r * q_2.r - bcw.i * q_2.i, q_1.i = bcw.r * q_2.i + bcw.i *
q_2.r;
difvn3.r = q_1.r, difvn3.i = q_1.i;
/*< dsgmo2=gmo2*0.5d0*(bew*conjg(cew2)+cew*conjg(bew2)) >*/
d_1 = gmo2 * .5;
r_cnjg(&q_3, &cew2);
q_2.r = bew.r * q_3.r - bew.i * q_3.i, q_2.i = bew.r * q_3.i + bew.i *
q_3.r;
r_cnjg(&q_5, &bew2);
q_4.r = cew.r * q_5.r - cew.i * q_5.i, q_4.i = cew.r * q_5.i + cew.i *
q_5.r;
q_1.r = q_2.r + q_4.r, q_1.i = q_2.i + q_4.i;
z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
dsgmo2.r = z_1.r, dsgmo2.i = z_1.i;
/*< go to 420 >*/
goto L420;
/* calculate im2s current generators */
/*< 400 difvn1=cew*cew2 >*/
L400:
q_1.r = cew.r * cew2.r - cew.i * cew2.i, q_1.i = cew.r * cew2.i +
cew.i * cew2.r;
difvn1.r = q_1.r, difvn1.i = q_1.i;
/*< difvn2=bew*bew2 >*/
q_1.r = bew.r * bew2.r - bew.i * bew2.i, q_1.i = bew.r * bew2.i +
bew.i * bew2.r;
difvn2.r = q_1.r, difvn2.i = q_1.i;
/*< difvn3=bcw*bcw2 >*/
q_1.r = bcw.r * bcw2.r - bcw.i * bcw2.i, q_1.i = bcw.r * bcw2.i +
bcw.i * bcw2.r;
difvn3.r = q_1.r, difvn3.i = q_1.i;
/*< dsgmo2=gmo2*0.5d0*(bew*cew2+bew2*cew) >*/
d_1 = gmo2 * .5;
q_2.r = bew.r * cew2.r - bew.i * cew2.i, q_2.i = bew.r * cew2.i +
bew.i * cew2.r;
q_3.r = bew2.r * cew.r - bew2.i * cew.i, q_3.i = bew2.r * cew.i +
bew2.i * cew.r;
q_1.r = q_2.r + q_3.r, q_1.i = q_2.i + q_3.i;
z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
dsgmo2.r = z_1.r, dsgmo2.i = z_1.i;
/*< go to 420 >*/
goto L420;
/* calculate im3 current generators */
/*< 410 difvi1=0.5d0*(ce2w*conjg(cew2)+cew*cew12) >*/
L410:
r_cnjg(&q_3, &cew2);
q_2.r = ce2w.r * q_3.r - ce2w.i * q_3.i, q_2.i = ce2w.r * q_3.i +
ce2w.i * q_3.r;
q_4.r = cew.r * cew12.r - cew.i * cew12.i, q_4.i = cew.r * cew12.i +
cew.i * cew12.r;
q_1.r = q_2.r + q_4.r, q_1.i = q_2.i + q_4.i;
z_1.r = q_1.r * .5, z_1.i = q_1.i * .5;
difvi1.r = z_1.r, difvi1.i = z_1.i;
/*< difvi2=0.5d0*(be2w*conjg(bew2)+bew*bew12) >*/
r_cnjg(&q_3, &bew2);
q_2.r = be2w.r * q_3.r - be2w.i * q_3.i, q_2.i = be2w.r * q_3.i +
be2w.i * q_3.r;
q_4.r = bew.r * bew12.r - bew.i * bew12.i, q_4.i = bew.r * bew12.i +
bew.i * bew12.r;
q_1.r = q_2.r + q_4.r, q_1.i = q_2.i + q_4.i;
z_1.r = q_1.r * .5, z_1.i = q_1.i * .5;
difvi2.r = z_1.r, difvi2.i = z_1.i;
/*< difvi3=0.5d0*(bc2w*conjg(bcw2)+bcw*bcw12) >*/
r_cnjg(&q_3, &bcw2);
q_2.r = bc2w.r * q_3.r - bc2w.i * q_3.i, q_2.i = bc2w.r * q_3.i +
bc2w.i * q_3.r;
q_4.r = bcw.r * bcw12.r - bcw.i * bcw12.i, q_4.i = bcw.r * bcw12.i +
bcw.i * bcw12.r;
q_1.r = q_2.r + q_4.r, q_1.i = q_2.i + q_4.i;
z_1.r = q_1.r * .5, z_1.i = q_1.i * .5;
difvi3.r = z_1.r, difvi3.i = z_1.i;
/*< difvn1=cew*cew*conjg(cew2)*0.75d0 >*/
q_2.r = cew.r * cew.r - cew.i * cew.i, q_2.i = cew.r * cew.i + cew.i *
cew.r;
r_cnjg(&q_3, &cew2);
q_1.r = q_2.r * q_3.r - q_2.i * q_3.i, q_1.i = q_2.r * q_3.i + q_2.i *
q_3.r;
z_1.r = q_1.r * .75, z_1.i = q_1.i * .75;
difvn1.r = z_1.r, difvn1.i = z_1.i;
/*< difvn2=bew*bew*conjg(bew2)*0.75d0 >*/
q_2.r = bew.r * bew.r - bew.i * bew.i, q_2.i = bew.r * bew.i + bew.i *
bew.r;
r_cnjg(&q_3, &bew2);
q_1.r = q_2.r * q_3.r - q_2.i * q_3.i, q_1.i = q_2.r * q_3.i + q_2.i *
q_3.r;
z_1.r = q_1.r * .75, z_1.i = q_1.i * .75;
difvn2.r = z_1.r, difvn2.i = z_1.i;
/*< difvn3=bcw*bcw*conjg(bcw2)*0.75d0 >*/
q_2.r = bcw.r * bcw.r - bcw.i * bcw.i, q_2.i = bcw.r * bcw.i + bcw.i *
bcw.r;
r_cnjg(&q_3, &bcw2);
q_1.r = q_2.r * q_3.r - q_2.i * q_3.i, q_1.i = q_2.r * q_3.i + q_2.i *
q_3.r;
z_1.r = q_1.r * .75, z_1.i = q_1.i * .75;
difvn3.r = z_1.r, difvn3.i = z_1.i;
/*< dsgmo2=gmo2*0.5d0*(conjg(bew2)*ce2w+bew*cew12+conjg(cew2)*be2w+ >*/
/*< 1 cew*bew12) >*/
d_1 = gmo2 * .5;
r_cnjg(&q_5, &bew2);
q_4.r = q_5.r * ce2w.r - q_5.i * ce2w.i, q_4.i = q_5.r * ce2w.i +
q_5.i * ce2w.r;
q_6.r = bew.r * cew12.r - bew.i * cew12.i, q_6.i = bew.r * cew12.i +
bew.i * cew12.r;
q_3.r = q_4.r + q_6.r, q_3.i = q_4.i + q_6.i;
r_cnjg(&q_8, &cew2);
q_7.r = q_8.r * be2w.r - q_8.i * be2w.i, q_7.i = q_8.r * be2w.i +
q_8.i * be2w.r;
q_2.r = q_3.r + q_7.r, q_2.i = q_3.i + q_7.i;
q_9.r = cew.r * bew12.r - cew.i * bew12.i, q_9.i = cew.r * bew12.i +
cew.i * bew12.r;
q_1.r = q_2.r + q_9.r, q_1.i = q_2.i + q_9.i;
z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
dsgmo2.r = z_1.r, dsgmo2.i = z_1.i;
/*< go to 430 >*/
goto L430;
/*< 420 dsgo2=go2*difvn1 >*/
L420:
z_1.r = go2 * difvn1.r, z_1.i = go2 * difvn1.i;
dsgo2.r = z_1.r, dsgo2.i = z_1.i;
/*< dsgm2=gm2*difvn2 >*/
z_1.r = gm2 * difvn2.r, z_1.i = gm2 * difvn2.i;
dsgm2.r = z_1.r, dsgm2.i = z_1.i;
/*< dsgmu2=gmu2*difvn3 >*/
z_1.r = gmu2 * difvn3.r, z_1.i = gmu2 * difvn3.i;
dsgmu2.r = z_1.r, dsgmu2.i = z_1.i;
/*< dsgpi2=gpi2*difvn2 >*/
z_1.r = gpi2 * difvn2.r, z_1.i = gpi2 * difvn2.i;
dsgpi2.r = z_1.r, dsgpi2.i = z_1.i;
/*< dscb1=0.5d0*cb1*omega*cmplx(-aimag(difvn2),real(difvn2)) >*/
d_1 = cb1 * .5 * status_1.omega;
d_2 = -(doublereal)r_imag(&difvn2);
d_3 = difvn2.r;
q_1.r = d_2, q_1.i = d_3;
z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
dscb1.r = z_1.r, dscb1.i = z_1.i;
/*< dscb1r=0.5d0*cb1r*omega*cmplx(-aimag(difvn3),real(difvn3)) >*/
d_1 = cb1r * .5 * status_1.omega;
d_2 = -(doublereal)r_imag(&difvn3);
d_3 = difvn3.r;
q_1.r = d_2, q_1.i = d_3;
z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
dscb1r.r = z_1.r, dscb1r.i = z_1.i;
/*< dscje1=0.5d0*cje1*omega*cmplx(-aimag(difvn2),real(difvn2)) >*/
d_1 = cje1 * .5 * status_1.omega;
d_2 = -(doublereal)r_imag(&difvn2);
d_3 = difvn2.r;
q_1.r = d_2, q_1.i = d_3;
z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
dscje1.r = z_1.r, dscje1.i = z_1.i;
/*< dscjc1=0.5d0*cjc1*omega*cmplx(-aimag(difvn3),real(difvn3)) >*/
d_1 = cjc1 * .5 * status_1.omega;
d_2 = -(doublereal)r_imag(&difvn3);
d_3 = difvn3.r;
q_1.r = d_2, q_1.i = d_3;
z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
dscjc1.r = z_1.r, dscjc1.i = z_1.i;
/*< go to 440 >*/
goto L440;
/*< 430 dsgo2=2.0d0*go2*difvi1+go3*difvn1 >*/
L430:
d_1 = go2 * 2.;
z_2.r = d_1 * difvi1.r, z_2.i = d_1 * difvi1.i;
z_3.r = go3 * difvn1.r, z_3.i = go3 * difvn1.i;
z_1.r = z_2.r + z_3.r, z_1.i = z_2.i + z_3.i;
dsgo2.r = z_1.r, dsgo2.i = z_1.i;
/*< dsgm2=2.0d0*gm2*difvi2+gm3*difvn2 >*/
d_1 = gm2 * 2.;
z_2.r = d_1 * difvi2.r, z_2.i = d_1 * difvi2.i;
z_3.r = gm3 * difvn2.r, z_3.i = gm3 * difvn2.i;
z_1.r = z_2.r + z_3.r, z_1.i = z_2.i + z_3.i;
dsgm2.r = z_1.r, dsgm2.i = z_1.i;
/*< dsgmu2=2.0d0*gmu2*difvi3+gmu3*difvn3 >*/
d_1 = gmu2 * 2.;
z_2.r = d_1 * difvi3.r, z_2.i = d_1 * difvi3.i;
z_3.r = gmu3 * difvn3.r, z_3.i = gmu3 * difvn3.i;
z_1.r = z_2.r + z_3.r, z_1.i = z_2.i + z_3.i;
dsgmu2.r = z_1.r, dsgmu2.i = z_1.i;
/*< dsgpi2=2.0d0*gpi2*difvi2+gpi3*difvn2 >*/
d_1 = gpi2 * 2.;
z_2.r = d_1 * difvi2.r, z_2.i = d_1 * difvi2.i;
z_3.r = gpi3 * difvn2.r, z_3.i = gpi3 * difvn2.i;
z_1.r = z_2.r + z_3.r, z_1.i = z_2.i + z_3.i;
dsgpi2.r = z_1.r, dsgpi2.i = z_1.i;
/*< dscb1=omega*(cb1*difvi2+cb2*difvn2/3.0d0) >*/
z_3.r = cb1 * difvi2.r, z_3.i = cb1 * difvi2.i;
z_5.r = cb2 * difvn2.r, z_5.i = cb2 * difvn2.i;
z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
dscb1.r = z_1.r, dscb1.i = z_1.i;
/*< dscb1=cmplx(-aimag(dscb1),real(dscb1)) >*/
d_1 = -(doublereal)r_imag(&dscb1);
d_2 = dscb1.r;
q_1.r = d_1, q_1.i = d_2;
dscb1.r = q_1.r, dscb1.i = q_1.i;
/*< dscb1r=omega*(cb1r*difvi3+cb2r*difvn3/3.0d0) >*/
z_3.r = cb1r * difvi3.r, z_3.i = cb1r * difvi3.i;
z_5.r = cb2r * difvn3.r, z_5.i = cb2r * difvn3.i;
z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
dscb1r.r = z_1.r, dscb1r.i = z_1.i;
/*< dscb1r=cmplx(-aimag(dscb1r),real(dscb1r)) >*/
d_1 = -(doublereal)r_imag(&dscb1r);
d_2 = dscb1r.r;
q_1.r = d_1, q_1.i = d_2;
dscb1r.r = q_1.r, dscb1r.i = q_1.i;
/*< dscje1=omega*(cje1*difvi2+cje2*difvn2/3.0d0) >*/
z_3.r = cje1 * difvi2.r, z_3.i = cje1 * difvi2.i;
z_5.r = cje2 * difvn2.r, z_5.i = cje2 * difvn2.i;
z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
dscje1.r = z_1.r, dscje1.i = z_1.i;
/*< dscje1=cmplx(-aimag(dscje1),real(dscje1)) >*/
d_1 = -(doublereal)r_imag(&dscje1);
d_2 = dscje1.r;
q_1.r = d_1, q_1.i = d_2;
dscje1.r = q_1.r, dscje1.i = q_1.i;
/*< dscjc1=omega*(cjc1*difvi3+cjc2*difvn3/3.0d0) >*/
z_3.r = cjc1 * difvi3.r, z_3.i = cjc1 * difvi3.i;
z_5.r = cjc2 * difvn3.r, z_5.i = cjc2 * difvn3.i;
z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
dscjc1.r = z_1.r, dscjc1.i = z_1.i;
/*< dscjc1=cmplx(-aimag(dscjc1),real(dscjc1)) >*/
d_1 = -(doublereal)r_imag(&dscjc1);
d_2 = dscjc1.r;
q_1.r = d_1, q_1.i = d_2;
dscjc1.r = q_1.r, dscjc1.i = q_1.i;
/* determine contribution of each distortion source */
/*< 440 cvabe=cvalue(icvadj+node2)-cvalue(icvadj+node3) >*/
L440:
i_1 = icvadj + node2 - 1;
i_2 = icvadj + node3 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
cvabe.r = q_1.r, cvabe.i = q_1.i;
/*< cvabc=cvalue(icvadj+node2)-cvalue(icvadj+node1) >*/
i_1 = icvadj + node2 - 1;
i_2 = icvadj + node1 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
cvabc.r = q_1.r, cvabc.i = q_1.i;
/*< cvace=cvalue(icvadj+node1)-cvalue(icvadj+node3) >*/
i_1 = icvadj + node1 - 1;
i_2 = icvadj + node3 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
cvace.r = q_1.r, cvace.i = q_1.i;
/*< disto1=dsgm2+dsgo2+dsgmo2 >*/
q_2.r = dsgm2.r + dsgo2.r, q_2.i = dsgm2.i + dsgo2.i;
q_1.r = q_2.r + dsgmo2.r, q_1.i = q_2.i + dsgmo2.i;
disto1.r = q_1.r, disto1.i = q_1.i;
/*< disto2=dsgpi2+dscb1+dscje1 >*/
q_2.r = dsgpi2.r + dscb1.r, q_2.i = dsgpi2.i + dscb1.i;
q_1.r = q_2.r + dscje1.r, q_1.i = q_2.i + dscje1.i;
disto2.r = q_1.r, disto2.i = q_1.i;
/*< disto3=dsgmu2+dscb1r+dscjc1 >*/
q_2.r = dsgmu2.r + dscb1r.r, q_2.i = dsgmu2.i + dscb1r.i;
q_1.r = q_2.r + dscjc1.r, q_1.i = q_2.i + dscjc1.i;
disto3.r = q_1.r, disto3.i = q_1.i;
/*< cvdo(1)=dsgm2*cvace*arg >*/
q_1.r = dsgm2.r * cvace.r - dsgm2.i * cvace.i, q_1.i = dsgm2.r *
cvace.i + dsgm2.i * cvace.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[0].r = z_1.r, cvdo[0].i = z_1.i;
/*< cvdo(2)=dsgpi2*cvabe*arg >*/
q_1.r = dsgpi2.r * cvabe.r - dsgpi2.i * cvabe.i, q_1.i = dsgpi2.r *
cvabe.i + dsgpi2.i * cvabe.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[1].r = z_1.r, cvdo[1].i = z_1.i;
/*< cvdo(3)=dsgo2*cvace*arg >*/
q_1.r = dsgo2.r * cvace.r - dsgo2.i * cvace.i, q_1.i = dsgo2.r *
cvace.i + dsgo2.i * cvace.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[2].r = z_1.r, cvdo[2].i = z_1.i;
/*< cvdo(4)=dsgmu2*cvabc*arg >*/
q_1.r = dsgmu2.r * cvabc.r - dsgmu2.i * cvabc.i, q_1.i = dsgmu2.r *
cvabc.i + dsgmu2.i * cvabc.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[3].r = z_1.r, cvdo[3].i = z_1.i;
/*< cvdo(5)=dsgmo2*cvace*arg >*/
q_1.r = dsgmo2.r * cvace.r - dsgmo2.i * cvace.i, q_1.i = dsgmo2.r *
cvace.i + dsgmo2.i * cvace.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[4].r = z_1.r, cvdo[4].i = z_1.i;
/*< cvdo(6)=dscb1*cvabe*arg >*/
q_1.r = dscb1.r * cvabe.r - dscb1.i * cvabe.i, q_1.i = dscb1.r *
cvabe.i + dscb1.i * cvabe.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[5].r = z_1.r, cvdo[5].i = z_1.i;
/*< cvdo(7)=dscb1r*cvabc*arg >*/
q_1.r = dscb1r.r * cvabc.r - dscb1r.i * cvabc.i, q_1.i = dscb1r.r *
cvabc.i + dscb1r.i * cvabc.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[6].r = z_1.r, cvdo[6].i = z_1.i;
/*< cvdo(8)=dscje1*cvabe*arg >*/
q_1.r = dscje1.r * cvabe.r - dscje1.i * cvabe.i, q_1.i = dscje1.r *
cvabe.i + dscje1.i * cvabe.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[7].r = z_1.r, cvdo[7].i = z_1.i;
/*< cvdo(9)=dscjc1*cvabc*arg >*/
q_1.r = dscjc1.r * cvabc.r - dscjc1.i * cvabc.i, q_1.i = dscjc1.r *
cvabc.i + dscjc1.i * cvabc.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[8].r = z_1.r, cvdo[8].i = z_1.i;
/*< if (kdisto.eq.3) go to 450 >*/
if (kdisto == 3) {
goto L450;
}
/*< if (kdisto.eq.7) go to 460 >*/
if (kdisto == 7) {
goto L460;
}
/*< cvdo(10)=cvdo(1)+cvdo(2)+cvdo(3)+cvdo(4)+cvdo(5)+cvdo(6)+cvdo(7)+ >*/
/*< 1 cvdo(8)+cvdo(9) >*/
q_8.r = cvdo[0].r + cvdo[1].r, q_8.i = cvdo[0].i + cvdo[1].i;
q_7.r = q_8.r + cvdo[2].r, q_7.i = q_8.i + cvdo[2].i;
q_6.r = q_7.r + cvdo[3].r, q_6.i = q_7.i + cvdo[3].i;
q_5.r = q_6.r + cvdo[4].r, q_5.i = q_6.i + cvdo[4].i;
q_4.r = q_5.r + cvdo[5].r, q_4.i = q_5.i + cvdo[5].i;
q_3.r = q_4.r + cvdo[6].r, q_3.i = q_4.i + cvdo[6].i;
q_2.r = q_3.r + cvdo[7].r, q_2.i = q_3.i + cvdo[7].i;
q_1.r = q_2.r + cvdo[8].r, q_1.i = q_2.i + cvdo[8].i;
cvdo[9].r = q_1.r, cvdo[9].i = q_1.i;
/*< cvdist=cvdist+cvdo(10) >*/
q_1.r = cvdist.r + cvdo[9].r, q_1.i = cvdist.i + cvdo[9].i;
cvdist.r = q_1.r, cvdist.i = q_1.i;
/*< if (iprnt.eq.0) go to 480 >*/
if (iprnt == 0) {
goto L480;
}
/*< do 445 j=1,10 >*/
for (j = 1; j <= 10; ++j) {
/*< call magphs(cvdo(j),xmag,xphs) >*/
magphs_(&cvdo[j - 1], &xmag, &xphs);
/*< cvdo(j)=cmplx(sngl(xmag),sngl(xphs)) >*/
i_1 = j - 1;
d_1 = xmag;
d_2 = xphs;
q_1.r = d_1, q_1.i = d_2;
cvdo[i_1].r = q_1.r, cvdo[i_1].i = q_1.i;
/*< 445 continue >*/
/* L445: */
}
/*< if (ititle.eq.0) write (iofile,301) >*/
if (ititle == 0) {
io__96.ciunit = status_1.iofile;
s_wsfe(&io__96);
e_wsfe();
}
/*< ititle=1 >*/
ititle = 1;
/*< write (iofile,446) value(locv),(vdo(1,j),j=1,10) >*/
io__97.ciunit = status_1.iofile;
s_wsfe(&io__97);
do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
doublereal));
for (j = 1; j <= 10; ++j) {
do_fio(&c__1, (char *)&vdo[(j << 1) - 2], (ftnlen)sizeof(real));
}
e_wsfe();
/*< 446 format(1h0,a8,'mag',1p12d10.3) >*/
/*< write (iofile,447) (vdo(2,j),j=1,10) >*/
io__98.ciunit = status_1.iofile;
s_wsfe(&io__98);
for (j = 1; j <= 10; ++j) {
do_fio(&c__1, (char *)&vdo[(j << 1) - 1], (ftnlen)sizeof(real));
}
e_wsfe();
/*< 447 format(9x,'phs',12(1x,f7.2,2x)) >*/
/*< go to 480 >*/
goto L480;
/*< 450 dgm2o3=gm2o3*cew*bew*bew*0.25d0 >*/
L450:
z_4.r = gm2o3 * cew.r, z_4.i = gm2o3 * cew.i;
z_3.r = z_4.r * bew.r - z_4.i * bew.i, z_3.i = z_4.r * bew.i + z_4.i *
bew.r;
z_2.r = z_3.r * bew.r - z_3.i * bew.i, z_2.i = z_3.r * bew.i + z_3.i *
bew.r;
z_1.r = z_2.r * .25, z_1.i = z_2.i * .25;
dgm2o3.r = z_1.r, dgm2o3.i = z_1.i;
/*< dgmo23=gmo23*bew*cew*cew*0.25d0 >*/
z_4.r = gmo23 * bew.r, z_4.i = gmo23 * bew.i;
z_3.r = z_4.r * cew.r - z_4.i * cew.i, z_3.i = z_4.r * cew.i + z_4.i *
cew.r;
z_2.r = z_3.r * cew.r - z_3.i * cew.i, z_2.i = z_3.r * cew.i + z_3.i *
cew.r;
z_1.r = z_2.r * .25, z_1.i = z_2.i * .25;
dgmo23.r = z_1.r, dgmo23.i = z_1.i;
/*< go to 470 >*/
goto L470;
/*< 460 dgm2o3=gm2o3*(0.5d0*bew*conjg(bew2)*cew+0.25d0*bew*bew* >*/
/*< 1 conjg(cew2)) >*/
L460:
z_5.r = bew.r * .5, z_5.i = bew.i * .5;
r_cnjg(&q_1, &bew2);
z_4.r = z_5.r * q_1.r - z_5.i * q_1.i, z_4.i = z_5.r * q_1.i + z_5.i *
q_1.r;
z_3.r = z_4.r * cew.r - z_4.i * cew.i, z_3.i = z_4.r * cew.i + z_4.i *
cew.r;
z_8.r = bew.r * .25, z_8.i = bew.i * .25;
z_7.r = z_8.r * bew.r - z_8.i * bew.i, z_7.i = z_8.r * bew.i + z_8.i *
bew.r;
r_cnjg(&q_2, &cew2);
z_6.r = z_7.r * q_2.r - z_7.i * q_2.i, z_6.i = z_7.r * q_2.i + z_7.i *
q_2.r;
z_2.r = z_3.r + z_6.r, z_2.i = z_3.i + z_6.i;
z_1.r = gm2o3 * z_2.r, z_1.i = gm2o3 * z_2.i;
dgm2o3.r = z_1.r, dgm2o3.i = z_1.i;
/*< dgmo23=gmo23*(0.5d0*cew*conjg(cew2)*bew+0.25d0*cew*cew* >*/
/*< 1 conjg(bew2)) >*/
z_5.r = cew.r * .5, z_5.i = cew.i * .5;
r_cnjg(&q_1, &cew2);
z_4.r = z_5.r * q_1.r - z_5.i * q_1.i, z_4.i = z_5.r * q_1.i + z_5.i *
q_1.r;
z_3.r = z_4.r * bew.r - z_4.i * bew.i, z_3.i = z_4.r * bew.i + z_4.i *
bew.r;
z_8.r = cew.r * .25, z_8.i = cew.i * .25;
z_7.r = z_8.r * cew.r - z_8.i * cew.i, z_7.i = z_8.r * cew.i + z_8.i *
cew.r;
r_cnjg(&q_2, &bew2);
z_6.r = z_7.r * q_2.r - z_7.i * q_2.i, z_6.i = z_7.r * q_2.i + z_7.i *
q_2.r;
z_2.r = z_3.r + z_6.r, z_2.i = z_3.i + z_6.i;
z_1.r = gmo23 * z_2.r, z_1.i = gmo23 * z_2.i;
dgmo23.r = z_1.r, dgmo23.i = z_1.i;
/*< 470 disto1=disto1+dgm2o3+dgmo23 >*/
L470:
q_2.r = disto1.r + dgm2o3.r, q_2.i = disto1.i + dgm2o3.i;
q_1.r = q_2.r + dgmo23.r, q_1.i = q_2.i + dgmo23.i;
disto1.r = q_1.r, disto1.i = q_1.i;
/*< cvdo(10)=dgm2o3*cvace*arg >*/
q_1.r = dgm2o3.r * cvace.r - dgm2o3.i * cvace.i, q_1.i = dgm2o3.r *
cvace.i + dgm2o3.i * cvace.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[9].r = z_1.r, cvdo[9].i = z_1.i;
/*< cvdo(11)=dgmo23*cvace*arg >*/
q_1.r = dgmo23.r * cvace.r - dgmo23.i * cvace.i, q_1.i = dgmo23.r *
cvace.i + dgmo23.i * cvace.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[10].r = z_1.r, cvdo[10].i = z_1.i;
/*< cvdo(12)=cvdo(1)+cvdo(2)+cvdo(3)+cvdo(4)+cvdo(5)+cvdo(6)+cvdo(7)+ >*/
/*< 1 cvdo(8)+cvdo(9)+cvdo(10)+cvdo(11) >*/
q_10.r = cvdo[0].r + cvdo[1].r, q_10.i = cvdo[0].i + cvdo[1].i;
q_9.r = q_10.r + cvdo[2].r, q_9.i = q_10.i + cvdo[2].i;
q_8.r = q_9.r + cvdo[3].r, q_8.i = q_9.i + cvdo[3].i;
q_7.r = q_8.r + cvdo[4].r, q_7.i = q_8.i + cvdo[4].i;
q_6.r = q_7.r + cvdo[5].r, q_6.i = q_7.i + cvdo[5].i;
q_5.r = q_6.r + cvdo[6].r, q_5.i = q_6.i + cvdo[6].i;
q_4.r = q_5.r + cvdo[7].r, q_4.i = q_5.i + cvdo[7].i;
q_3.r = q_4.r + cvdo[8].r, q_3.i = q_4.i + cvdo[8].i;
q_2.r = q_3.r + cvdo[9].r, q_2.i = q_3.i + cvdo[9].i;
q_1.r = q_2.r + cvdo[10].r, q_1.i = q_2.i + cvdo[10].i;
cvdo[11].r = q_1.r, cvdo[11].i = q_1.i;
/*< cvdist=cvdist+cvdo(12) >*/
q_1.r = cvdist.r + cvdo[11].r, q_1.i = cvdist.i + cvdo[11].i;
cvdist.r = q_1.r, cvdist.i = q_1.i;
/*< if (iprnt.eq.0) go to 480 >*/
if (iprnt == 0) {
goto L480;
}
/*< do 475 j=1,12 >*/
for (j = 1; j <= 12; ++j) {
/*< call magphs(cvdo(j),xmag,xphs) >*/
magphs_(&cvdo[j - 1], &xmag, &xphs);
/*< cvdo(j)=cmplx(sngl(xmag),sngl(xphs)) >*/
i_1 = j - 1;
d_1 = xmag;
d_2 = xphs;
q_1.r = d_1, q_1.i = d_2;
cvdo[i_1].r = q_1.r, cvdo[i_1].i = q_1.i;
/*< 475 continue >*/
/* L475: */
}
/*< if (ititle.eq.0) write (iofile,311) >*/
if (ititle == 0) {
io__101.ciunit = status_1.iofile;
s_wsfe(&io__101);
e_wsfe();
}
/*< ititle=1 >*/
ititle = 1;
/*< write (iofile,446) value(locv),(vdo(1,j),j=1,12) >*/
io__102.ciunit = status_1.iofile;
s_wsfe(&io__102);
do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
doublereal));
for (j = 1; j <= 12; ++j) {
do_fio(&c__1, (char *)&vdo[(j << 1) - 2], (ftnlen)sizeof(real));
}
e_wsfe();
/*< write (iofile,447) (vdo(2,j),j=1,12) >*/
io__103.ciunit = status_1.iofile;
s_wsfe(&io__103);
for (j = 1; j <= 12; ++j) {
do_fio(&c__1, (char *)&vdo[(j << 1) - 1], (ftnlen)sizeof(real));
}
e_wsfe();
/*< 480 value(lvn+node1)=value(lvn+node1) >*/
/*< 1 -real(disto1-disto3) >*/
L480:
q_1.r = disto1.r - disto3.r, q_1.i = disto1.i - disto3.i;
blank_1.value[tabinf_1.lvn + node1 - 1] -= q_1.r;
/*< value(lvn+node2)=value(lvn+node2) >*/
/*< 1 -real(disto2+disto3) >*/
q_1.r = disto2.r + disto3.r, q_1.i = disto2.i + disto3.i;
blank_1.value[tabinf_1.lvn + node2 - 1] -= q_1.r;
/*< value(lvn+node3)=value(lvn+node3) >*/
/*< 1 +real(disto1+disto2) >*/
q_1.r = disto1.r + disto2.r, q_1.i = disto1.i + disto2.i;
blank_1.value[tabinf_1.lvn + node3 - 1] += q_1.r;
/*< value(imvn+node1)=value(imvn+node1) >*/
/*< 1 -aimag(disto1-disto3) >*/
q_1.r = disto1.r - disto3.r, q_1.i = disto1.i - disto3.i;
blank_1.value[tabinf_1.imvn + node1 - 1] -= r_imag(&q_1);
/*< value(imvn+node2)=value(imvn+node2) >*/
/*< 1 -aimag(disto2+disto3) >*/
q_1.r = disto2.r + disto3.r, q_1.i = disto2.i + disto3.i;
blank_1.value[tabinf_1.imvn + node2 - 1] -= r_imag(&q_1);
/*< value(imvn+node3)=value(imvn+node3) >*/
/*< 1 +aimag(disto1+disto2) >*/
q_1.r = disto1.r + disto2.r, q_1.i = disto1.i + disto2.i;
blank_1.value[tabinf_1.imvn + node3 - 1] += r_imag(&q_1);
/*< loc=nodplc(loc) >*/
loc = nodplc[loc - 1];
/*< go to 330 >*/
goto L330;
/* junction diodes */
/*< 500 if (jelcnt(11).eq.0) go to 700 >*/
L500:
if (cirdat_1.jelcnt[10] == 0) {
goto L700;
}
/*< ititle=0 >*/
ititle = 0;
/*< 501 format (////1x,'diode distortion components'//1x,'name', >*/
/*< 1 11x,'geq',7x,'cb',8x,'cj',7x,'total') >*/
/* L501: */
/*< 510 loc=locate(11) >*/
/* L510: */
loc = cirdat_1.locate[10];
/*< 520 if ((loc.eq.0).or.(nodplc(loc+16).ne.0)) go to 700 >*/
L520:
if (loc == 0 || nodplc[loc + 15] != 0) {
goto L700;
}
/*< locv=nodplc(loc+1) >*/
locv = nodplc[loc];
/*< node1=nodplc(loc+2) >*/
node1 = nodplc[loc + 1];
/*< node2=nodplc(loc+3) >*/
node2 = nodplc[loc + 2];
/*< node3=nodplc(loc+4) >*/
node3 = nodplc[loc + 3];
/*< locm=nodplc(loc+5) >*/
locm = nodplc[loc + 4];
/*< locm=nodplc(locm+1) >*/
locm = nodplc[locm];
/*< loct=lx0+nodplc(loc+11) >*/
loct = tabinf_1.lx0 + nodplc[loc + 10];
/*< locd=ld0+nodplc(loc+12) >*/
locd = tabinf_1.ld0 + nodplc[loc + 11];
/*< cdj1=value(locd) >*/
cdj1 = blank_1.value[locd - 1];
/*< cdj2=value(locd+1) >*/
cdj2 = blank_1.value[locd];
/*< cdb1=value(locd+3) >*/
cdb1 = blank_1.value[locd + 2];
/*< geq2=value(locd+4) >*/
geq2 = blank_1.value[locd + 3];
/*< geq3=value(locd+5) >*/
geq3 = blank_1.value[locd + 4];
/*< cdb2=value(locd+6) >*/
cdb2 = blank_1.value[locd + 5];
/*< bew=cvalue(icvw1+node3)-cvalue(icvw1+node2) >*/
i_1 = icvw1 + node3 - 1;
i_2 = icvw1 + node2 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
bew.r = q_1.r, bew.i = q_1.i;
/*< if (kdisto.eq.2) go to 540 >*/
if (kdisto == 2) {
goto L540;
}
/*< be2w=cvalue(icv2w1+node3)-cvalue(icv2w1+node2) >*/
i_1 = icv2w1 + node3 - 1;
i_2 = icv2w1 + node2 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
be2w.r = q_1.r, be2w.i = q_1.i;
/*< if (kdisto.eq.3) go to 550 >*/
if (kdisto == 3) {
goto L550;
}
/*< bew2=cvalue(icvw2+node3)-cvalue(icvw2+node2) >*/
i_1 = icvw2 + node3 - 1;
i_2 = icvw2 + node2 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
bew2.r = q_1.r, bew2.i = q_1.i;
/*< if (kdisto.eq.5) go to 560 >*/
if (kdisto == 5) {
goto L560;
}
/*< if (kdisto.eq.6) go to 570 >*/
if (kdisto == 6) {
goto L570;
}
/*< bew12=cvalue(icvw12+node3)-cvalue(icvw12+node2) >*/
i_1 = icvw12 + node3 - 1;
i_2 = icvw12 + node2 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
bew12.r = q_1.r, bew12.i = q_1.i;
/*< go to 580 >*/
goto L580;
/* calculate hd2 current generators */
/*< 540 difvn1=0.5d0*bew*bew >*/
L540:
z_2.r = bew.r * .5, z_2.i = bew.i * .5;
z_1.r = z_2.r * bew.r - z_2.i * bew.i, z_1.i = z_2.r * bew.i + z_2.i *
bew.r;
difvn1.r = z_1.r, difvn1.i = z_1.i;
/*< go to 590 >*/
goto L590;
/* calculate hd3 current generators */
/*< 550 difvi1=0.5d0*bew*be2w >*/
L550:
z_2.r = bew.r * .5, z_2.i = bew.i * .5;
z_1.r = z_2.r * be2w.r - z_2.i * be2w.i, z_1.i = z_2.r * be2w.i +
z_2.i * be2w.r;
difvi1.r = z_1.r, difvi1.i = z_1.i;
/*< difvn1=0.25d0*bew*bew*bew >*/
z_3.r = bew.r * .25, z_3.i = bew.i * .25;
z_2.r = z_3.r * bew.r - z_3.i * bew.i, z_2.i = z_3.r * bew.i + z_3.i *
bew.r;
z_1.r = z_2.r * bew.r - z_2.i * bew.i, z_1.i = z_2.r * bew.i + z_2.i *
bew.r;
difvn1.r = z_1.r, difvn1.i = z_1.i;
/*< go to 600 >*/
goto L600;
/* calculate im2d current generators */
/*< 560 difvn1=bew*conjg(bew2) >*/
L560:
r_cnjg(&q_2, &bew2);
q_1.r = bew.r * q_2.r - bew.i * q_2.i, q_1.i = bew.r * q_2.i + bew.i *
q_2.r;
difvn1.r = q_1.r, difvn1.i = q_1.i;
/*< go to 590 >*/
goto L590;
/* calculate im2s current generators */
/*< 570 difvn1=bew*bew2 >*/
L570:
q_1.r = bew.r * bew2.r - bew.i * bew2.i, q_1.i = bew.r * bew2.i +
bew.i * bew2.r;
difvn1.r = q_1.r, difvn1.i = q_1.i;
/*< go to 590 >*/
goto L590;
/* calculate im3 current generators */
/*< 580 difvi1=0.5d0*(be2w*conjg(bew2)+bew*bew12) >*/
L580:
r_cnjg(&q_3, &bew2);
q_2.r = be2w.r * q_3.r - be2w.i * q_3.i, q_2.i = be2w.r * q_3.i +
be2w.i * q_3.r;
q_4.r = bew.r * bew12.r - bew.i * bew12.i, q_4.i = bew.r * bew12.i +
bew.i * bew12.r;
q_1.r = q_2.r + q_4.r, q_1.i = q_2.i + q_4.i;
z_1.r = q_1.r * .5, z_1.i = q_1.i * .5;
difvi1.r = z_1.r, difvi1.i = z_1.i;
/*< difvn1=bew*bew*conjg(bew2)*0.75d0 >*/
q_2.r = bew.r * bew.r - bew.i * bew.i, q_2.i = bew.r * bew.i + bew.i *
bew.r;
r_cnjg(&q_3, &bew2);
q_1.r = q_2.r * q_3.r - q_2.i * q_3.i, q_1.i = q_2.r * q_3.i + q_2.i *
q_3.r;
z_1.r = q_1.r * .75, z_1.i = q_1.i * .75;
difvn1.r = z_1.r, difvn1.i = z_1.i;
/*< go to 600 >*/
goto L600;
/*< 590 dsg2=geq2*difvn1 >*/
L590:
z_1.r = geq2 * difvn1.r, z_1.i = geq2 * difvn1.i;
dsg2.r = z_1.r, dsg2.i = z_1.i;
/*< dscdb1=0.5d0*cdb1*omega*cmplx(-aimag(difvn1),real(difvn1)) >*/
d_1 = cdb1 * .5 * status_1.omega;
d_2 = -(doublereal)r_imag(&difvn1);
d_3 = difvn1.r;
q_1.r = d_2, q_1.i = d_3;
z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
dscdb1.r = z_1.r, dscdb1.i = z_1.i;
/*< dscdj1=0.5d0*cdj1*omega*cmplx(-aimag(difvn1),real(difvn1)) >*/
d_1 = cdj1 * .5 * status_1.omega;
d_2 = -(doublereal)r_imag(&difvn1);
d_3 = difvn1.r;
q_1.r = d_2, q_1.i = d_3;
z_1.r = d_1 * q_1.r, z_1.i = d_1 * q_1.i;
dscdj1.r = z_1.r, dscdj1.i = z_1.i;
/*< go to 610 >*/
goto L610;
/*< 600 dsg2=2.0d0*geq2*difvi1+geq3*difvn1 >*/
L600:
d_1 = geq2 * 2.;
z_2.r = d_1 * difvi1.r, z_2.i = d_1 * difvi1.i;
z_3.r = geq3 * difvn1.r, z_3.i = geq3 * difvn1.i;
z_1.r = z_2.r + z_3.r, z_1.i = z_2.i + z_3.i;
dsg2.r = z_1.r, dsg2.i = z_1.i;
/*< dscdb1=omega*(cdb1*difvi1+cdb2*difvn1/3.0d0) >*/
z_3.r = cdb1 * difvi1.r, z_3.i = cdb1 * difvi1.i;
z_5.r = cdb2 * difvn1.r, z_5.i = cdb2 * difvn1.i;
z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
dscdb1.r = z_1.r, dscdb1.i = z_1.i;
/*< dscdb1=cmplx(-aimag(dscdb1),real(dscdb1)) >*/
d_1 = -(doublereal)r_imag(&dscdb1);
d_2 = dscdb1.r;
q_1.r = d_1, q_1.i = d_2;
dscdb1.r = q_1.r, dscdb1.i = q_1.i;
/*< dscdj1=omega*(cdj1*difvi1+cdj2*difvn1/3.0d0) >*/
z_3.r = cdj1 * difvi1.r, z_3.i = cdj1 * difvi1.i;
z_5.r = cdj2 * difvn1.r, z_5.i = cdj2 * difvn1.i;
z_4.r = z_5.r / 3., z_4.i = z_5.i / 3.;
z_2.r = z_3.r + z_4.r, z_2.i = z_3.i + z_4.i;
z_1.r = status_1.omega * z_2.r, z_1.i = status_1.omega * z_2.i;
dscdj1.r = z_1.r, dscdj1.i = z_1.i;
/*< dscdj1=cmplx(-aimag(dscdj1),real(dscdj1)) >*/
d_1 = -(doublereal)r_imag(&dscdj1);
d_2 = dscdj1.r;
q_1.r = d_1, q_1.i = d_2;
dscdj1.r = q_1.r, dscdj1.i = q_1.i;
/* determine contribution of each distortion source */
/*< 610 cvabe=cvalue(icvadj+node3)-cvalue(icvadj+node2) >*/
L610:
i_1 = icvadj + node3 - 1;
i_2 = icvadj + node2 - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
cvabe.r = q_1.r, cvabe.i = q_1.i;
/*< disto1=dsg2+dscdb1+dscdj1 >*/
q_2.r = dsg2.r + dscdb1.r, q_2.i = dsg2.i + dscdb1.i;
q_1.r = q_2.r + dscdj1.r, q_1.i = q_2.i + dscdj1.i;
disto1.r = q_1.r, disto1.i = q_1.i;
/*< cvdo(1)=dsg2*cvabe*arg >*/
q_1.r = dsg2.r * cvabe.r - dsg2.i * cvabe.i, q_1.i = dsg2.r * cvabe.i
+ dsg2.i * cvabe.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[0].r = z_1.r, cvdo[0].i = z_1.i;
/*< cvdo(2)=dscdb1*cvabe*arg >*/
q_1.r = dscdb1.r * cvabe.r - dscdb1.i * cvabe.i, q_1.i = dscdb1.r *
cvabe.i + dscdb1.i * cvabe.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[1].r = z_1.r, cvdo[1].i = z_1.i;
/*< cvdo(3)=dscdj1*cvabe*arg >*/
q_1.r = dscdj1.r * cvabe.r - dscdj1.i * cvabe.i, q_1.i = dscdj1.r *
cvabe.i + dscdj1.i * cvabe.r;
z_1.r = arg * q_1.r, z_1.i = arg * q_1.i;
cvdo[2].r = z_1.r, cvdo[2].i = z_1.i;
/*< cvdo(4)=cvdo(1)+cvdo(2)+cvdo(3) >*/
q_2.r = cvdo[0].r + cvdo[1].r, q_2.i = cvdo[0].i + cvdo[1].i;
q_1.r = q_2.r + cvdo[2].r, q_1.i = q_2.i + cvdo[2].i;
cvdo[3].r = q_1.r, cvdo[3].i = q_1.i;
/*< cvdist=cvdist+cvdo(4) >*/
q_1.r = cvdist.r + cvdo[3].r, q_1.i = cvdist.i + cvdo[3].i;
cvdist.r = q_1.r, cvdist.i = q_1.i;
/*< if (iprnt.eq.0) go to 680 >*/
if (iprnt == 0) {
goto L680;
}
/*< do 670 j=1,4 >*/
for (j = 1; j <= 4; ++j) {
/*< call magphs(cvdo(j),xmag,xphs) >*/
magphs_(&cvdo[j - 1], &xmag, &xphs);
/*< cvdo(j)=cmplx(sngl(xmag),sngl(xphs)) >*/
i_1 = j - 1;
d_1 = xmag;
d_2 = xphs;
q_1.r = d_1, q_1.i = d_2;
cvdo[i_1].r = q_1.r, cvdo[i_1].i = q_1.i;
/*< 670 continue >*/
/* L670: */
}
/*< if (ititle.eq.0) write (iofile,501) >*/
if (ititle == 0) {
io__114.ciunit = status_1.iofile;
s_wsfe(&io__114);
e_wsfe();
}
/*< ititle=1 >*/
ititle = 1;
/*< write (iofile,446) value(locv),(vdo(1,j),j=1,4) >*/
io__115.ciunit = status_1.iofile;
s_wsfe(&io__115);
do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
doublereal));
for (j = 1; j <= 4; ++j) {
do_fio(&c__1, (char *)&vdo[(j << 1) - 2], (ftnlen)sizeof(real));
}
e_wsfe();
/*< write (iofile,447) (vdo(2,j),j=1,4) >*/
io__116.ciunit = status_1.iofile;
s_wsfe(&io__116);
for (j = 1; j <= 4; ++j) {
do_fio(&c__1, (char *)&vdo[(j << 1) - 1], (ftnlen)sizeof(real));
}
e_wsfe();
/*< 680 value(lvn+node2)=value(lvn+node2)+real(disto1) >*/
L680:
blank_1.value[tabinf_1.lvn + node2 - 1] += disto1.r;
/*< value(lvn+node3)=value(lvn+node3)-real(disto1) >*/
blank_1.value[tabinf_1.lvn + node3 - 1] -= disto1.r;
/*< value(imvn+node2)=value(imvn+node2)+aimag(disto1) >*/
blank_1.value[tabinf_1.imvn + node2 - 1] += r_imag(&disto1);
/*< value(imvn+node3)=value(imvn+node3)-aimag(disto1) >*/
blank_1.value[tabinf_1.imvn + node3 - 1] -= r_imag(&disto1);
/*< loc=nodplc(loc) >*/
loc = nodplc[loc - 1];
/*< go to 520 >*/
goto L520;
/* obtain total distortion solution if necessary */
/*< 700 go to (1000,710,790,710,710,840,860),kdisto >*/
L700:
switch (kdisto) {
case 1: goto L1000;
case 2: goto L710;
case 3: goto L790;
case 4: goto L710;
case 5: goto L710;
case 6: goto L840;
case 7: goto L860;
}
/*< 710 call acsol >*/
L710:
acsol_();
/* store solution, print and store answers */
/*< 760 go to (1000,770,790,800,820,840,860),kdisto >*/
/* L760: */
switch (kdisto) {
case 1: goto L1000;
case 2: goto L770;
case 3: goto L790;
case 4: goto L800;
case 5: goto L820;
case 6: goto L840;
case 7: goto L860;
}
/*< 770 call copy16(cvalue(lcvn+1),cvalue(icv2w1+1),nstop) >*/
L770:
copy16_(&cvalue[tabinf_1.lcvn], &cvalue[icv2w1], &cirdat_1.nstop);
/*< call magphs(cvdist,o2mag,o2phs) >*/
magphs_(&cvdist, &o2mag, &o2phs);
/*< if (iprnt.eq.0) go to 900 >*/
if (iprnt == 0) {
goto L900;
}
/*< o2log=20.0d0*dlog10(o2mag) >*/
o2log = d_lg10(&o2mag) * 20.;
/*< write (iofile,781) o2mag,o2phs,o2log >*/
io__120.ciunit = status_1.iofile;
s_wsfe(&io__120);
do_fio(&c__1, (char *)&o2mag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&o2phs, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&o2log, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 781 format (///5x,'hd2 magnitude ',1pd10.3,5x,'phase ',0pf7.2, >*/
/*< 1 5x,'= ',f7.2,' db') >*/
/*< go to 900 >*/
goto L900;
/*< 790 call magphs(cvdist,o3mag,o3phs) >*/
L790:
magphs_(&cvdist, &o3mag, &o3phs);
/*< if (iprnt.eq.0) go to 900 >*/
if (iprnt == 0) {
goto L900;
}
/*< o3log=20.0d0*dlog10(o3mag) >*/
o3log = d_lg10(&o3mag) * 20.;
/*< write (iofile,791) o3mag,o3phs,o3log >*/
io__124.ciunit = status_1.iofile;
s_wsfe(&io__124);
do_fio(&c__1, (char *)&o3mag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&o3phs, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&o3log, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 791 format (///5x,'hd3 magnitude ',1pd10.3,5x,'phase ',0pf7.2, >*/
/*< 1 5x,'= ',f7.2,' db') >*/
/*< go to 900 >*/
goto L900;
/*< 800 call copy16(cvalue(lcvn+1),cvalue(icvw2+1),nstop) >*/
L800:
copy16_(&cvalue[tabinf_1.lcvn], &cvalue[icvw2], &cirdat_1.nstop);
/*< cvout=cvalue(icvw2+idnp)-cvalue(icvw2+idnn) >*/
i_1 = icvw2 + idnp - 1;
i_2 = icvw2 + idnn - 1;
q_1.r = cvalue[i_1].r - cvalue[i_2].r, q_1.i = cvalue[i_1].i - cvalue[
i_2].i;
cvout.r = q_1.r, cvout.i = q_1.i;
/*< call magphs(cvout,ow2mag,ow2phs) >*/
magphs_(&cvout, &ow2mag, &ow2phs);
/*< go to 1000 >*/
goto L1000;
/*< 820 call copy16(cvalue(lcvn+1),cvalue(icvw12+1),nstop) >*/
L820:
copy16_(&cvalue[tabinf_1.lcvn], &cvalue[icvw12], &cirdat_1.nstop);
/*< 840 call magphs(cvdist,o12mag,o12phs) >*/
L840:
magphs_(&cvdist, &o12mag, &o12phs);
/*< if (iprnt.eq.0) go to 900 >*/
if (iprnt == 0) {
goto L900;
}
/*< o12log=20.0d0*dlog10(o12mag) >*/
o12log = d_lg10(&o12mag) * 20.;
/*< if (kdisto.eq.6) go to 850 >*/
if (kdisto == 6) {
goto L850;
}
/*< write (iofile,841) o12mag,o12phs,o12log >*/
io__128.ciunit = status_1.iofile;
s_wsfe(&io__128);
do_fio(&c__1, (char *)&o12mag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&o12phs, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&o12log, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 841 format (///5x,'im2d magnitude ',1pd10.3,5x,'phase ',0pf7.2, >*/
/*< 1 5x,'= ',f7.2,' db') >*/
/*< go to 900 >*/
goto L900;
/*< 850 write (iofile,851) o12mag,o12phs,o12log >*/
L850:
io__129.ciunit = status_1.iofile;
s_wsfe(&io__129);
do_fio(&c__1, (char *)&o12mag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&o12phs, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&o12log, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 851 format (///5x,'im2s magnitude ',1pd10.3,5x,'phase ',0pf7.2, >*/
/*< 1 5x,'= ',f7.2,' db') >*/
/*< go to 900 >*/
goto L900;
/*< 860 call magphs(cvdist,o21mag,o21phs) >*/
L860:
magphs_(&cvdist, &o21mag, &o21phs);
/*< if (iprnt.eq.0) go to 900 >*/
if (iprnt == 0) {
goto L900;
}
/*< o21log=20.0d0*dlog10(o21mag) >*/
o21log = d_lg10(&o21mag) * 20.;
/*< write (iofile,861) o21mag,o21phs,o21log >*/
io__133.ciunit = status_1.iofile;
s_wsfe(&io__133);
do_fio(&c__1, (char *)&o21mag, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&o21phs, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&o21log, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 861 format (///5x,'im3 magnitude ',1pd10.3,5x,'phase ',0pf7.2, >*/
/*< 1 5x,'= ',f7.2,' db') >*/
/*< cma=dabs(4.0d0*o21mag*dcos((o21phs-ophase)/rad)) >*/
cma = (d_1 = o21mag * 4. * cos((o21phs - ophase) / knstnt_1.rad), abs(
d_1));
/*< cma=dmax1(cma,1.0d-20) >*/
cma = max(cma,1e-20);
/*< cmp=dabs(4.0d0*o21mag*dsin((o21phs-ophase)/rad)) >*/
cmp = (d_1 = o21mag * 4. * sin((o21phs - ophase) / knstnt_1.rad), abs(
d_1));
/*< cmp=dmax1(cmp,1.0d-20) >*/
cmp = max(cmp,1e-20);
/*< cmalog=20.0d0*dlog10(cma) >*/
cmalog = d_lg10(&cma) * 20.;
/*< cmplog=20.0d0*dlog10(cmp) >*/
cmplog = d_lg10(&cmp) * 20.;
/*< write (iofile,866) >*/
io__138.ciunit = status_1.iofile;
s_wsfe(&io__138);
e_wsfe();
/*< 866 format (////5x,'approximate cross modulation components') >*/
/*< write (iofile,871) cma,cmalog >*/
io__139.ciunit = status_1.iofile;
s_wsfe(&io__139);
do_fio(&c__1, (char *)&cma, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&cmalog, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 871 format (/5x,'cma magnitude ',1pd10.3,24x,'= ',0pf7.2,' db') >*/
/*< write (iofile,881) cmp,cmplog >*/
io__140.ciunit = status_1.iofile;
s_wsfe(&io__140);
do_fio(&c__1, (char *)&cmp, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&cmplog, (ftnlen)sizeof(doublereal));
e_wsfe();
/*< 881 format (/5x,'cmp magnitude ',1pd10.3,24x,'= ',0pf7.2,' db') >*/
/* save distortion outputs */
/*< 900 iflag=kdisto+2 >*/
L900:
iflag = kdisto + 2;
/*< if (iflag.ge.7) iflag=iflag-1 >*/
if (iflag >= 7) {
--iflag;
}
/*< loc=locate(45) >*/
loc = cirdat_1.locate[44];
/*< 910 if (loc.eq.0) go to 1000 >*/
L910:
if (loc == 0) {
goto L1000;
}
/*< if (nodplc(loc+5).ne.iflag) go to 920 >*/
if (nodplc[loc + 4] != iflag) {
goto L920;
}
/*< iseq=nodplc(loc+4) >*/
tabinf_1.iseq = nodplc[loc + 3];
/*< cvalue(loco+iseq)=cvdist >*/
i_1 = *loco + tabinf_1.iseq - 1;
cvalue[i_1].r = cvdist.r, cvalue[i_1].i = cvdist.i;
/*< 920 loc=nodplc(loc) >*/
L920:
loc = nodplc[loc - 1];
/*< go to 910 >*/
goto L910;
/*< 1000 continue >*/
L1000:
;}
/* finished */
/*< 2000 return >*/
/* L2000: */
return 0;
/*< end >*/
} /* disto_ */
#undef vdo
#undef cvalue
#undef nodplc
#undef cvdo
#undef distit